home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS03.ADF / ABasiCprogs / bj.bas < prev    next >
BASIC Source File  |  1986-04-02  |  8KB  |  234 lines
  1. 1     rem BLACK JACK
  2. 50    rgb 0,5,13,0
  3. 90    goto 180
  4. 100   rem  Card Shuffle
  5. 110   dim n(52,10)
  6. 120   d=1
  7. 130   for dn=1 to d:for c=1 to 52:n(c,dn)=c:next:next
  8. 140   for dn= 1 to d
  9. 150   randomize
  10. 160   for c=1 to 52:c1=int(rnd(1)*52)+1:c2 =int(rnd(1)*52)+1:t=n(c1,dn)
  11. 170   n(c1,dn)=n(c2,dn):n(c2,dn)=t:next:next
  12. 175   ca=1:dn=1: rem renamed cards ca and decks dn
  13. 177   return
  14. 180   '
  15. 185   gosub 2040
  16. 200   rem set up table
  17. 202   graphic 1
  18. 205   scnclr
  19. 210   p3=0:p4=0:p5=0:p6=0
  20. 211   z=1:bet=0
  21. 212   gosub 295
  22. 220   peno 1:circle (150,0),390,.25
  23. 230   circle(150,130),20
  24. 231   paint(150,130),0
  25. 232   ?at(138,125);"BET"
  26. 233   ?at(138,135);bet
  27. 240   ask mouse x%,y%,b%:if b%<>4 then 240
  28. 242   box(110,40;190,60)
  29. 244   ?at(130,52);"DEAL ?"
  30. 250   if y%<100 then 300
  31. 255   ?at(138,135);bet+1:bet=bet+1:pot=pot-1:gosub 295
  32. 257   sleep 1*10^5
  33. 260   goto 240
  34. 295   ?at(20,7);" YOU HAVE"POT"IN YOUR POCKET "
  35. 296   rem x%=sound(9,0,0,32,240)
  36. 297   sleep 1*10^5
  37. 298   rem audio 9,-1
  38. 299   return
  39. 300   rem deal first cards
  40. 301   x=10:y=100:gosub 2010:' 1st
  41. 302   p1=v
  42. 306   x=10:y=10:gshape(x,y),card53%
  43. 307   gosub 2020:dc=n(ca,dn):d1=v:sleep 1*10^5
  44. 308   ca=ca+1:if ca>52 then gosub 2040
  45. 310   x=50:y=100:gosub 2010
  46. 311   p2=v
  47. 315   x=75:y=10:gosub 2010
  48. 316   d2=v
  49. 320   ' see if bj
  50. 325   p=p1+p2
  51. 326   if p=21 then gosub 2030:?at(20,130);" YOU HAVE A BLACK JACK ":goto 4000
  52. 330   d=d1+d2
  53. 332   if p=21 and d=21 then gosub 2030:goto 4000
  54. 335   if d=21 then gosub 2030:?at(20,80);" DEALER HAS BLACK JACK ":goto 2050
  55. 340   if p=11 or p=10 then 3000
  56. 350   rem deal rest of player
  57. 355   ?at(0,88);" CLICK IN YOUR CARDS TO HIT "
  58. 357   ?at(0,96);" CLICK IN DEALERS CARDS TO STAND"
  59. 360   ask mouse x%,y%,b%:if b%<>4 then 360
  60. 361   if y%>100 and z=1 goto 365
  61. 362   if y%>100 and z=2  goto 375:if y%>100 and z=3 goto 385
  62. 363   if y%<100 then 400
  63. 364   goto 360
  64. 365   x=90:y=100:gosub 2010:p3=v
  65. 366   p=p1+p2+p3:z=2
  66. 367   if p1=11 and p>21 then p=p-10
  67. 368   if p2=11 and p>21 then p=p-10
  68. 369   if p3=11 and p>21 then p=p-10
  69. 370   if p>21 then ?at(30,130);"  BUST  ":gosub 2030:goto 2050
  70. 373   sleep 1*10^6
  71. 374   goto 360
  72. 375   x=130:y=100:gosub 2010:p4=v
  73. 376   p=p1+p2+p3+p4:z=3
  74. 377   if p1=11 and p>21 then p=p-10
  75. 378   if p2=11 and p>21 then p=p-10
  76. 379   if p3=11 and p>21 then p=p-10
  77. 380   if p4=11 and p>21 then p=p-10
  78. 381   if p>21 then ?at(40,130);"BUST":gosub 2030:goto 2050
  79. 384   sleep 1*10^6:goto 360
  80. 385   x=170:y=100:gosub 2010:p5=v
  81. 386   p=p1+p2+p3+p4+p5:z=5
  82. 387   if p1=11 and p>21 then p=p-10
  83. 388   if p2=11 and p>21 then p=p-10
  84. 389   if p3=11 and p>21 then p=p-10
  85. 390   if p4=11 and p>21 then p=p-10
  86. 391   if p5=11 and p>21 then p=p-10
  87. 393   if p>21 then ?at(40,130);"  BUST ":gosub 2030:goto 2050
  88. 395   ?at(40,130);"YOU HAVE FIVE CARDS"
  89. 396   ?at(40,110);" YOU WIN "
  90. 397   goto 2050
  91. 399   stop
  92. 400   '
  93. 403   gosub 2030
  94. 404   if d>16 then 500
  95. 405   if d<17 then x=115:y=10:gosub 2010:d3=v
  96. 406   d=d1+d2+d3
  97. 408   if d1=11 and d>21 then d=d-10
  98. 410   if d2=11 and d>21 then d=d-10
  99. 412   if d3=11 and d>21 then d=d-10
  100. 413   if d>21 then ?at(30,60);"DEALER BUST":goto 4000
  101. 414   if d>16 then 500
  102. 415   if d<17 then x=155:y=10:gosub 2010:d4=v
  103. 416   d=d1+d2+d3+d4
  104. 417   if d1=11 and d>21 then d=d-10
  105. 418   if d2=11 and d>21 then d=d-10
  106. 419   if d3=11 and d>21 then d=d-10
  107. 420   if d4=11 and d>21 then d=d-10
  108. 422   if d>21 then ?at(30,60);"DEALER BUST":goto 4000
  109. 423   if d>16 then 500
  110. 425   if d<17 then x=195:y=10:gosub 2010:d5=v
  111. 426   d=d1+d2+d3+d4+d5
  112. 427   if d5=11 and d>21then d=d-10
  113. 432   if d>21 then 422
  114. 434   if d>16 then 500
  115. 435     if d<17 then x=235:y=10:gosub 2010:d6=v
  116. 436     d=d1+d2+d3+d4+d5+d6
  117. 442   if d>21 then 422
  118. 443   if d>16 then 500
  119. 445   stop :rem if gets this far needs another card
  120. 500   '
  121. 510   if p=d then ?at(30,30);"PUSH":?at(30,130);"PUSH":goto 4000
  122. 520   if p>d then ?at(30,130);" YOU WIN ":goto 4000
  123. 530   if p<d then ?at(30,130);" YOU LOSE ":goto 2050
  124. 999   stop
  125. 1000  rem
  126. 1010  if c=1 then gshape(x,y),card1%
  127. 1020  if c=2 then gshape(x,y),card2%
  128. 1030  if c=3 then gshape(x,y),card3%
  129. 1040  if c=4 then gshape(x,y),card4%
  130. 1050  if c=5 then gshape(x,y),card5%
  131. 1060  if c=6 then gshape(x,y),card6%
  132. 1070  if c=7 then gshape(x,y),card7%
  133. 1080  if c=8 then gshape(x,y),card8%
  134. 1090  if c=9 then gshape(x,y),card9%
  135. 1100  if c=10 then gshape(x,y),card10%
  136. 1110  if c=11 then gshape(x,y),card11%
  137. 1120  if c=12 then gshape(x,y),card12%
  138. 1130  if c=13 then gshape(x,y),card13%
  139. 1140  if c=14 then gshape(x,y),card14%
  140. 1150  if c=15 then gshape(x,y),card15%
  141. 1160  if c=16 then gshape(x,y),card16%
  142. 1170  if c=17 then gshape(x,y),card17%
  143. 1180  if c=18 then gshape(x,y),card18%
  144. 1190  if c=19 then gshape(x,y),card19%
  145. 1200  if c=20 then gshape(x,y),card20%
  146. 1210  if c=21 then gshape(x,Y),card21%
  147. 1220  if c=22 then gshape(x,y),card22%
  148. 1230  if c=23 then gshape(x,y),card23%
  149. 1240  if c=24 then gshape(x,y),card24%
  150. 1250  if c=25 then gshape(x,y),card25%
  151. 1260  if c=26 then gshape(x,y),card26%
  152. 1270  if c=27 then gshape(x,y),card27%
  153. 1280  if c=28 then gshape(x,y),card28%
  154. 1290  if c=29 then gshape(x,y),card29%
  155. 1300  if c=30 then gshape(x,y),card30%
  156. 1310  if c=31 then gshape(x,y),card31%
  157. 1320  if c=32 then gshape(x,y),card32%
  158. 1330  if c=33 then gshape(x,y),card33%
  159. 1340  if c=34 then gshape(x,y),card34%
  160. 1350  if c=35 then gshape(x,y),card35%
  161. 1360  if c=36 then gshape(x,y),card36%
  162. 1370  if c=37 then gshape(x,y),card37%
  163. 1380  if c=38 then gshape(x,y),card38%
  164. 1390  if c=39 then gshape(x,y),card39%
  165. 1400  if c=40 then gshape(x,y),card40%
  166. 1410  if c=41 then gshape(x,y),card41%
  167. 1420  if c=42 then gshape(x,y),card42%
  168. 1430  if c=43 then gshape(x,y),card43%
  169. 1440  if c=44 then gshape(x,y),card44%
  170. 1450  if c=45 then gshape(x,y),card45%
  171. 1460  if c=46 then gshape(x,y),card46%
  172. 1470  if c=47 then gshape(x,y),card47%
  173. 1480  if c=48 then gshape(x,y),card48%
  174. 1490  if c=49 then gshape(x,y),card49%
  175. 1500  if c=50 then gshape(x,y),card50%
  176. 1510  if c=51 then gshape(x,y),card51%
  177. 1520  if c=52 then gshape(x,y),card52%
  178. 1600  return
  179. 2000  rem start of subroutines
  180. 2001  end
  181. 2010  c=n(ca,dn):gosub 2020:ca=ca+1:gosub 1000
  182. 2011  if ca>52 then gosub 2040
  183. 2012  sleep 1*10^4
  184. 2018  return
  185. 2020  rem determine value
  186. 2022  v=n(ca,dn) mod 13
  187. 2024  if v>9 then v=10
  188. 2025  if v=0 then v=10
  189. 2026  if v=1 then v=11
  190. 2029  return
  191. 2030  c=dc:x=10:y=10:gosub 1000:return:rem print down card
  192. 2040  erase n
  193. 2042  ?at(130,180);"Shuffle
  194. 2044  sleep 2*10^6
  195. 2046  penb 8:?at(130,180);"       "
  196. 2048  gosub 100
  197. 2049  return
  198. 2050  rem
  199. 2052  pena 4:penb 6
  200. 2054  ?at(20,150);"  TRY AGAIN    OR      QUIT  "
  201. 2056  ask mouse x%,y%,b%:if b%=4 and x%<160 then 200
  202. 2058  if b%=4 then chain "casino",37,all
  203. 2060  gosub 2074
  204. 2062  ?at(20,150);"              "
  205. 2064  ?at(200,150);"QUIT ?"
  206. 2066  gosub 2074
  207. 2068  ?at(20,150);"  TRY AGAIN ?"
  208. 2070  ?at(200,150);"      "
  209. 2072  goto 2056
  210. 2074  sleep 1*10^5:return
  211. 3000  rem  DOUBLE DOWN
  212. 3002  pena 6:penb 4
  213. 3004  ?at(20,180);"          DOUBLE DOWN           "
  214. 3006  ask mouse x%,y%,b%:if b%=4 and x%<160 then 3030
  215. 3008  if b%=4 then 3025
  216. 3010  gosub 3024
  217. 3012  ?at(20,180);"      "
  218. 3014  ?at(230,180);"NO ?"
  219. 3016  gosub 3024
  220. 3018  ?at(20,180);" YES ?"
  221. 3020  ?at(230,180);"     "
  222. 3022  goto 3006
  223. 3024  sleep 1*10^5:return
  224. 3025  gosub 3028: goto 350:rem continue
  225. 3026  stop
  226. 3028  penb 8:?at(20,180);"                                ":return
  227. 3030  rem one card
  228. 3031  pot=pot-bet:gosub 295:bet=bet+bet
  229. 3032  gosub 3028:x=90:y=100:gosub 2010:p=p+v:if v=11 and p>21 then p=p-10:goto 400
  230. 3033  goto 400
  231. 4000  rem calculate winnings
  232. 4010  if p=d then pot=pot+bet:gosub 295:goto 2050
  233. 4020  for t=1 to bet*2:pot=pot+1:gosub 295:next:goto 2050
  234.